Introduction
This is your assignment for Module 4 Putting It All Together, focused
on the material you learned in the lectures and recitation activities on
PCA, Manhattan plots, interactive
plots, and the leftovers
Submission info:
- Please submit this assignment by uploading a knitted
.html to Carmen
- Your headers should be logical and your report and code annotated
with descriptions of what you’re doing. Starting on this assignment, I
will be considering for overall format and readability of your
assignment as part of your grade. I am doing this because the format of
your report will be considered for your final capstone assignment. This
means you should have reasonable headers and header levels,
understandable flow between plots and code, and use Markdown language
when appropriate.
- Make sure you include the Code Download button so that I can see
your code as well
- Customize the YAML and the document so you like how it looks
Remember there are often many ways to reach the same end product. I
have showed you many ways in class to achieve a similar end product, you
only need to show me one of them. As long as your answer is reasonable,
you will get full credit even if its different than what I intended.
This assignment will be due on Wednesday, November 30, 2022, at
11:59pm.
Data
The data
we will be using is the same we used in the ggplot102
recitation that includes information about dog breed trait
information from the American Kennel Club.
Download the data using the code below. Don’t use the code from week
5 recitation.
breed_traits <- readr::read_csv('data/breed_traits_fixed.csv')
trait_description <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2022/2022-02-01/trait_description.csv')
breed_rank_all <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2022/2022-02-01/breed_rank.csv')
For a little hint, here are the packages I used to complete this
task. Yours might not be exactly the same.
library(tidyverse)
library(factoextra)
library(glue)
library(patchwork)
library(ggrepel)
library(plotly)
library(gghighlight)
1. Principal components analysis (PCA) of American Kennel Club dog
bred trait data (6 pts)
Run a PCA on breed_traits for all of the numeric data
present in that dataset. Create the following plots and make them of
publication quality:
- A scree plot
- A scores plot
- A loadings plot
- A two panel plot that has the scores plot and the scree plot
together
breed_traits_quant <- breed_traits %>%
select(-`Coat Type`, -`Coat Length`)
# run PCA
# no scaling (because all are on the same scale)
# centering is a good idea
trait_pca <- prcomp(breed_traits_quant[,-1],
scale = FALSE,
center = TRUE)
importance <- summary(trait_pca)$importance %>%
as.data.frame()
Scree plot
With fviz_eig()
fviz_eig(trait_pca)

Manually
importance_tidy <- importance %>%
rownames_to_column(var = "measure") %>%
pivot_longer(cols = PC1:PC10,
names_to = "PC",
values_to = "value")
# create a vector with the order we want
my_order <- colnames(importance)
# relevel according to my_order
importance_tidy$PC <- fct_relevel(importance_tidy$PC, levels = my_order)
## Warning: Outer names are only allowed for unnamed scalar atomic inputs
## Warning: 4 unknown levels in `f`: PC11, PC12, PC13, and PC14
# plot
(scree_plot <- importance_tidy %>%
filter(measure == "Proportion of Variance") %>%
ggplot(aes(x = PC, y = value)) +
geom_col(alpha = 0.1, color = "black") +
scale_y_continuous(labels = scales::percent) +
theme_minimal() +
labs(x = "Principal component",
y = "Percent variance explained",
title = "Scree plot of dog traits"))

Scores plot
With fviz_pca_ind()
fviz_pca_ind(trait_pca)

Manually
# create a df of trait_pca$x
scores_raw <- as.data.frame(trait_pca$x)
# bind breed name
scores <- bind_cols(breed_traits[,1], # first column where we have breed name
scores_raw)
# create objects indicating percent variance explained by PC1 and PC2
PC1_percent <- round((importance[2,1])*100, # index 2nd row, 1st column, times 100
1) # round to 1 decimal
PC2_percent <- round((importance[2,2])*100, 1)
# plot
(scores_plot <- scores %>%
ggplot(aes(x = PC1, y = PC2)) +
geom_hline(yintercept = 0, linetype = "dashed") +
geom_vline(xintercept = 0, linetype = "dashed") +
geom_point(color = "black") +
theme_minimal() +
labs(x = glue("PC1: {PC1_percent}%"),
y = glue("PC2: {PC2_percent}%"),
title = "PCA Scores Plot of American Kennel Club Dog Trait Data"))

Loadings plot
With fviz_pca_var()
fviz_pca_var(trait_pca)

Manually
# grab raw loadings, without any metadata
loadings_raw <- as.data.frame(trait_pca$rotation)
# move rowname to column
loadings <- loadings_raw %>%
rownames_to_column(var = "Trait")
(loadings_plot <- loadings %>%
ggplot(aes(x = PC1, y = PC2, label = Trait)) +
geom_hline(yintercept = 0, linetype = "dashed") +
geom_vline(xintercept = 0, linetype = "dashed") +
geom_point() +
geom_label_repel(size = 2.5) +
theme_minimal() +
labs(x = glue("PC1: {PC1_percent}%"),
y = glue("PC2: {PC2_percent}%"),
title = "PCA Loadings Plot of American Kennel Club Dog Trait Data"))

Scree and scores plots
scree_plot + scores_plot

2. Make your PCA plot interactive (2 pts)
Make your PCA scores plot interactive, and so that when you hover
each point, you can see what the name of that dog breed is (and only the
breed of that dog).
scores_plotly <- scores %>%
ggplot(aes(x = PC1, y = PC2, text = Breed)) +
geom_hline(yintercept = 0, linetype = "dashed") +
geom_vline(xintercept = 0, linetype = "dashed") +
geom_point(color = "black") +
theme_minimal() +
labs(x = glue("PC1: {PC1_percent}%"),
y = glue("PC2: {PC2_percent}%"),
title = "PCA Scores Plot of American Kennel Club Dog Trait Data")
ggplotly(scores_plotly, tooltip = "text")
3. See how your PCA related to breed popularity (2 pts)
Using breed_traits and breed_rank_all,
label the points that show data for the top 10 dog breeds in 2020 and
color them different from the rest of the points. Your plot does not
need to be interactive.
Try joining the dfs based on Breed
# grab just breed and the rank in 2020
breed_rank_to_join <- breed_rank_all %>%
select(Breed, `2020 Rank`)
# join with breed_traits
joined <- left_join(breed_traits, breed_rank_to_join,
by = "Breed")
# check
knitr::kable(head(joined))
| Retrievers (Labrador) |
5 |
5 |
5 |
4 |
2 |
2 |
Double |
Short |
5 |
5 |
3 |
5 |
5 |
5 |
3 |
4 |
NA |
| French Bulldogs |
5 |
5 |
4 |
3 |
1 |
3 |
Smooth |
Short |
5 |
5 |
3 |
5 |
4 |
3 |
1 |
3 |
NA |
| German Shepherd Dogs |
5 |
5 |
3 |
4 |
2 |
2 |
Double |
Medium |
3 |
4 |
5 |
5 |
5 |
5 |
3 |
5 |
NA |
| Retrievers (Golden) |
5 |
5 |
5 |
4 |
2 |
2 |
Double |
Medium |
5 |
4 |
3 |
5 |
5 |
3 |
1 |
4 |
NA |
| Bulldogs |
4 |
3 |
3 |
3 |
3 |
3 |
Smooth |
Short |
4 |
4 |
3 |
3 |
4 |
3 |
2 |
3 |
5 |
| Poodles |
5 |
5 |
3 |
1 |
4 |
1 |
Curly |
Long |
5 |
5 |
5 |
4 |
5 |
4 |
4 |
5 |
6 |
We have a bunch of NAs in 2020 Rank lets figure out why.
I notice we have NAs in all the Breed names that have spaces
# create a vector of breed from each df
breed_traits_breed <- breed_traits$Breed
breed_rank_breed <- breed_rank_all$Breed
# are they the same?
all.equal(breed_traits_breed, breed_rank_breed) # no, many string mismatches
## [1] "146 string mismatches"
# testing with French Bulldogs bc those are my fav
test1 <- breed_traits_breed[2]
test2 <- breed_rank_breed[2]
library(stringi) # has the function stri_compare()
stri_compare(test1, test2) # 1 string different, but ok which one?
## [1] 1
library(devtools) # allows you to use install_github
## Loading required package: usethis
install_github("renozao/pkgmaker") # install pkgmaker for string comparison
## Skipping install of 'pkgmaker' from a github remote, the SHA1 (3c58d769) has not changed since last install.
## Use `force = TRUE` to force installation
library(pkgmaker)
## Loading required package: registry
str_diff(test1, test2) # the problem is in the space! But what? It looks the same to me
## French Bulldogs
## ......*........
## French Bulldogs
# this solution was from Dan Zhang (thanks Dan!)
charToRaw(test1)
## [1] 46 72 65 6e 63 68 c2 a0 42 75 6c 6c 64 6f 67 73
charToRaw(test2)
## [1] 46 72 65 6e 63 68 20 42 75 6c 6c 64 6f 67 73
# test1 has c2a0 for the space, and test2 has 20
# c2a0 is a weird type of space, and 20 is the regular space
# if you actually download and open the csvs in a program like excel
# you will see some weird unicode nonsense (my fault)
Trying another way to join. Since we can check that the dfs are
ordered the same way, we can join by using bind_cols().
# create df of just 2020 rank to add to bind to scores
rank2020 <- breed_rank_all %>%
select(`2020 Rank`)
# bind to scores
# joining is tough here because it doesn't handle spaces well
# here i made sure that both dfs were ordered exactly the same way
scores_popularity <- bind_cols(scores, rank2020)
scores_popularity_top10 <- scores_popularity %>%
filter(`2020 Rank` <= 10)
By creating a new df and plotting
# creating a new df and plotting
scores_popularity %>%
ggplot() +
geom_hline(yintercept = 0, linetype = "dashed") +
geom_vline(xintercept = 0, linetype = "dashed") +
geom_point(aes(x = PC1, y = PC2)) +
geom_point(data = scores_popularity_top10,
aes(x = PC1, y = PC2), color = "darkcyan") +
geom_label_repel(data = scores_popularity_top10,
aes(x = PC1, y = PC2, label = Breed),
color = "darkcyan", size = 2.5) +
theme_minimal() +
theme(legend.position = "none") +
labs(x = glue("PC1: {PC1_percent}%"),
y = glue("PC2: {PC2_percent}%"),
title = "PCA Scores Plot of American Kennel Club Dog Trait Data",
subtitle = "Labelled points are the top 10 most popular breeds from 2020")

Without creating a new df, and using if_else()
# without creating a new df and if_else
scores_popularity %>%
ggplot(aes(x = PC1, y = PC2)) +
geom_hline(yintercept = 0, linetype = "dashed") +
geom_vline(xintercept = 0, linetype = "dashed") +
geom_point() +
geom_point(color = if_else(scores_popularity$`2020 Rank` <= 10, "darkcyan", "black")) +
geom_label_repel(aes(label = if_else(`2020 Rank` <= 10, Breed, NULL)),
size = 2.5, color = "darkcyan") +
theme_minimal() +
theme(legend.position = "none") +
labs(x = glue("PC1: {PC1_percent}%"),
y = glue("PC2: {PC2_percent}%"),
title = "PCA Scores Plot of American Kennel Club Dog Trait Data",
subtitle = "Labelled points are the top 10 most popular breeds from 2020")
## Warning: Removed 185 rows containing missing values (geom_label_repel).

Using gghighlight()
# using gghighlight
scores_popularity %>%
ggplot() +
geom_hline(yintercept = 0, linetype = "dashed") +
geom_vline(xintercept = 0, linetype = "dashed") +
geom_point(aes(x = PC1, y = PC2)) +
gghighlight(`2020 Rank` <= 10, use_direct_label = TRUE, label_key = Breed) +
theme_minimal() +
labs(x = glue("PC1: {PC1_percent}%"),
y = glue("PC2: {PC2_percent}%"),
title = "PCA Scores Plot of American Kennel Club Dog Trait Data",
subtitle = "Labelled points are the top 10 most popular breeds from 2020")
## Warning: Could not calculate the predicate for layer 1, layer 2; ignored

LS0tCnRpdGxlOiAiTW9kdWxlIDQgQXNzaWdubWVudCIKYXV0aG9yOiAiWW91IgpkYXRlOiAiRHVlIDExLTMwLTIwMjIiCm91dHB1dDoKICBodG1sX2RvY3VtZW50OgogICAgdG9jOiB0cnVlCiAgICB0b2NfZGVwdGg6IDUKICAgIHRvY19mbG9hdDogdHJ1ZQogICAgdGhlbWU6IGZsYXRseQogICAgY29kZV9kb3dubG9hZDogdHJ1ZQotLS0KCmBgYHtyIHNldHVwLCBpbmNsdWRlPUZBTFNFfQprbml0cjo6b3B0c19jaHVuayRzZXQoZWNobyA9IFRSVUUpCmBgYAoKIyMgSW50cm9kdWN0aW9uClRoaXMgaXMgeW91ciBhc3NpZ25tZW50IGZvciBNb2R1bGUgNCBQdXR0aW5nIEl0IEFsbCBUb2dldGhlciwgZm9jdXNlZCBvbiB0aGUgbWF0ZXJpYWwgeW91IGxlYXJuZWQgaW4gdGhlIGxlY3R1cmVzIGFuZCByZWNpdGF0aW9uIGFjdGl2aXRpZXMgb24gW1BDQV0oNF8wOV9QQ0EvMDlfcGNhLmh0bWwpLCBbTWFuaGF0dGFuIHBsb3RzXSg0XzEwX21hbmhhdHRhbi8xMF9tYW5oYXR0YW4uaHRtbCksIFtpbnRlcmFjdGl2ZSBwbG90c10oNF8xMV9pbnRlcmFjdGl2ZV9wbG90cy80XzExX2ludGVyYWN0aXZlX3Bsb3RzLmh0bWwpLCBhbmQgdGhlIFtsZWZ0b3ZlcnNdKDRfMTJfbGVmdG92ZXJzLzRfMTJfbGVmdG92ZXJzLmh0bWwpCgpTdWJtaXNzaW9uIGluZm86CgotIFBsZWFzZSBzdWJtaXQgdGhpcyBhc3NpZ25tZW50IGJ5IHVwbG9hZGluZyBhICoqa25pdHRlZCAuaHRtbCoqIHRvIENhcm1lbgotIFlvdXIgaGVhZGVycyBzaG91bGQgYmUgbG9naWNhbCBhbmQgeW91ciByZXBvcnQgYW5kIGNvZGUgYW5ub3RhdGVkIHdpdGggZGVzY3JpcHRpb25zIG9mIHdoYXQgeW91J3JlIGRvaW5nLiBTdGFydGluZyBvbiB0aGlzIGFzc2lnbm1lbnQsIEkgd2lsbCBiZSBjb25zaWRlcmluZyBmb3Igb3ZlcmFsbCBmb3JtYXQgYW5kIHJlYWRhYmlsaXR5IG9mIHlvdXIgYXNzaWdubWVudCBhcyBwYXJ0IG9mIHlvdXIgZ3JhZGUuIEkgYW0gZG9pbmcgdGhpcyBiZWNhdXNlIHRoZSBmb3JtYXQgb2YgeW91ciByZXBvcnQgd2lsbCBiZSBjb25zaWRlcmVkIGZvciB5b3VyIGZpbmFsIGNhcHN0b25lIGFzc2lnbm1lbnQuIFRoaXMgbWVhbnMgeW91IHNob3VsZCBoYXZlIHJlYXNvbmFibGUgaGVhZGVycyBhbmQgaGVhZGVyIGxldmVscywgdW5kZXJzdGFuZGFibGUgZmxvdyBiZXR3ZWVuIHBsb3RzIGFuZCBjb2RlLCBhbmQgdXNlIE1hcmtkb3duIGxhbmd1YWdlIHdoZW4gYXBwcm9wcmlhdGUuCi0gTWFrZSBzdXJlIHlvdSBpbmNsdWRlIHRoZSBDb2RlIERvd25sb2FkIGJ1dHRvbiBzbyB0aGF0IEkgY2FuIHNlZSB5b3VyIGNvZGUgYXMgd2VsbAotIEN1c3RvbWl6ZSB0aGUgWUFNTCBhbmQgdGhlIGRvY3VtZW50IHNvIHlvdSBsaWtlIGhvdyBpdCBsb29rcwoKUmVtZW1iZXIgdGhlcmUgYXJlIG9mdGVuIG1hbnkgd2F5cyB0byByZWFjaCB0aGUgc2FtZSBlbmQgcHJvZHVjdC4gSSBoYXZlIHNob3dlZCB5b3UgbWFueSB3YXlzIGluIGNsYXNzIHRvIGFjaGlldmUgYSBzaW1pbGFyIGVuZCBwcm9kdWN0LCB5b3Ugb25seSBuZWVkIHRvIHNob3cgbWUgb25lIG9mIHRoZW0uIEFzIGxvbmcgYXMgeW91ciBhbnN3ZXIgaXMgcmVhc29uYWJsZSwgeW91IHdpbGwgZ2V0IGZ1bGwgY3JlZGl0IGV2ZW4gaWYgaXRzIGRpZmZlcmVudCB0aGFuIHdoYXQgSSBpbnRlbmRlZC4KCj4gVGhpcyBhc3NpZ25tZW50IHdpbGwgYmUgZHVlIG9uIFdlZG5lc2RheSwgTm92ZW1iZXIgMzAsIDIwMjIsIGF0IDExOjU5cG0uCgojIyMgRGF0YQpUaGUgW2RhdGFdKGh0dHBzOi8vZ2l0aHViLmNvbS9yZm9yZGF0YXNjaWVuY2UvdGlkeXR1ZXNkYXkvYmxvYi9tYXN0ZXIvZGF0YS8yMDIyLzIwMjItMDItMDEvcmVhZG1lLm1kKSB3ZSB3aWxsIGJlIHVzaW5nIGlzIHRoZSBzYW1lIHdlIHVzZWQgaW4gdGhlIFtnZ3Bsb3QxMDIgcmVjaXRhdGlvbl0oMl8wNV90aGVtZXNfbGFiZWxzX2ZhY2V0cy8wNV9nZ3Bsb3QxMDJfcmVjaXRhdGlvbi5odG1sKSB0aGF0IGluY2x1ZGVzIGluZm9ybWF0aW9uIGFib3V0IGRvZyBicmVlZCB0cmFpdCBpbmZvcm1hdGlvbiBmcm9tIHRoZSBBbWVyaWNhbiBLZW5uZWwgQ2x1Yi4KCkRvd25sb2FkIHRoZSBkYXRhIHVzaW5nIHRoZSBjb2RlIGJlbG93LiBEb24ndCB1c2UgdGhlIGNvZGUgZnJvbSB3ZWVrIDUgcmVjaXRhdGlvbi4KYGBge3IsIG1lc3NhZ2UgPSBGQUxTRSwgd2FybmluZyA9IEZBTFNFfQpicmVlZF90cmFpdHMgPC0gcmVhZHI6OnJlYWRfY3N2KCdkYXRhL2JyZWVkX3RyYWl0c19maXhlZC5jc3YnKQoKdHJhaXRfZGVzY3JpcHRpb24gPC0gcmVhZHI6OnJlYWRfY3N2KCdodHRwczovL3Jhdy5naXRodWJ1c2VyY29udGVudC5jb20vcmZvcmRhdGFzY2llbmNlL3RpZHl0dWVzZGF5L21hc3Rlci9kYXRhLzIwMjIvMjAyMi0wMi0wMS90cmFpdF9kZXNjcmlwdGlvbi5jc3YnKQoKYnJlZWRfcmFua19hbGwgPC0gcmVhZHI6OnJlYWRfY3N2KCdodHRwczovL3Jhdy5naXRodWJ1c2VyY29udGVudC5jb20vcmZvcmRhdGFzY2llbmNlL3RpZHl0dWVzZGF5L21hc3Rlci9kYXRhLzIwMjIvMjAyMi0wMi0wMS9icmVlZF9yYW5rLmNzdicpCmBgYAoKRm9yIGEgbGl0dGxlIGhpbnQsIGhlcmUgYXJlIHRoZSBwYWNrYWdlcyBJIHVzZWQgdG8gY29tcGxldGUgdGhpcyB0YXNrLiBZb3VycyBtaWdodCBub3QgYmUgZXhhY3RseSB0aGUgc2FtZS4KYGBge3IsIG1lc3NhZ2UgPSBGQUxTRSwgd2FybmluZyA9IEZBTFNFfQpsaWJyYXJ5KHRpZHl2ZXJzZSkKbGlicmFyeShmYWN0b2V4dHJhKQpsaWJyYXJ5KGdsdWUpCmxpYnJhcnkocGF0Y2h3b3JrKQpsaWJyYXJ5KGdncmVwZWwpCmxpYnJhcnkocGxvdGx5KQpsaWJyYXJ5KGdnaGlnaGxpZ2h0KQpgYGAKCgojIyAxLiBQcmluY2lwYWwgY29tcG9uZW50cyBhbmFseXNpcyAoUENBKSBvZiBBbWVyaWNhbiBLZW5uZWwgQ2x1YiBkb2cgYnJlZCB0cmFpdCBkYXRhICg2IHB0cykKClJ1biBhIFBDQSBvbiBgYnJlZWRfdHJhaXRzYCBmb3IgYWxsIG9mIHRoZSBudW1lcmljIGRhdGEgcHJlc2VudCBpbiB0aGF0IGRhdGFzZXQuIENyZWF0ZSB0aGUgZm9sbG93aW5nIHBsb3RzIGFuZCBtYWtlIHRoZW0gb2YgcHVibGljYXRpb24gcXVhbGl0eToKCjEuIEEgc2NyZWUgcGxvdAoyLiBBIHNjb3JlcyBwbG90CjMuIEEgbG9hZGluZ3MgcGxvdAo0LiBBIHR3byBwYW5lbCBwbG90IHRoYXQgaGFzIHRoZSBzY29yZXMgcGxvdCBhbmQgdGhlIHNjcmVlIHBsb3QgdG9nZXRoZXIKCmBgYHtyfQpicmVlZF90cmFpdHNfcXVhbnQgPC0gYnJlZWRfdHJhaXRzICU+JQogIHNlbGVjdCgtYENvYXQgVHlwZWAsIC1gQ29hdCBMZW5ndGhgKQoKIyBydW4gUENBCiMgbm8gc2NhbGluZyAoYmVjYXVzZSBhbGwgYXJlIG9uIHRoZSBzYW1lIHNjYWxlKQojIGNlbnRlcmluZyBpcyBhIGdvb2QgaWRlYQp0cmFpdF9wY2EgPC0gcHJjb21wKGJyZWVkX3RyYWl0c19xdWFudFssLTFdLAogICAgICAgICAgICAgICAgICAgIHNjYWxlID0gRkFMU0UsCiAgICAgICAgICAgICAgICAgICAgY2VudGVyID0gVFJVRSkKCmltcG9ydGFuY2UgPC0gc3VtbWFyeSh0cmFpdF9wY2EpJGltcG9ydGFuY2UgJT4lCiAgYXMuZGF0YS5mcmFtZSgpCmBgYAoKIyMjIFNjcmVlIHBsb3QKCiMjIyMgV2l0aCBgZnZpel9laWcoKWAKYGBge3J9CmZ2aXpfZWlnKHRyYWl0X3BjYSkKYGBgCgojIyMjIE1hbnVhbGx5CmBgYHtyfQppbXBvcnRhbmNlX3RpZHkgPC0gaW1wb3J0YW5jZSAlPiUKICByb3duYW1lc190b19jb2x1bW4odmFyID0gIm1lYXN1cmUiKSAlPiUKICBwaXZvdF9sb25nZXIoY29scyA9IFBDMTpQQzEwLAogICAgICAgICAgICAgICBuYW1lc190byA9ICJQQyIsCiAgICAgICAgICAgICAgIHZhbHVlc190byA9ICJ2YWx1ZSIpCgojIGNyZWF0ZSBhIHZlY3RvciB3aXRoIHRoZSBvcmRlciB3ZSB3YW50Cm15X29yZGVyIDwtIGNvbG5hbWVzKGltcG9ydGFuY2UpCgojIHJlbGV2ZWwgYWNjb3JkaW5nIHRvIG15X29yZGVyCmltcG9ydGFuY2VfdGlkeSRQQyA8LSBmY3RfcmVsZXZlbChpbXBvcnRhbmNlX3RpZHkkUEMsIGxldmVscyA9IG15X29yZGVyKQoKIyBwbG90CihzY3JlZV9wbG90IDwtIGltcG9ydGFuY2VfdGlkeSAlPiUKICBmaWx0ZXIobWVhc3VyZSA9PSAiUHJvcG9ydGlvbiBvZiBWYXJpYW5jZSIpICU+JQogIGdncGxvdChhZXMoeCA9IFBDLCB5ICA9IHZhbHVlKSkgKwogIGdlb21fY29sKGFscGhhID0gMC4xLCBjb2xvciA9ICJibGFjayIpICsKICBzY2FsZV95X2NvbnRpbnVvdXMobGFiZWxzID0gc2NhbGVzOjpwZXJjZW50KSArCiAgdGhlbWVfbWluaW1hbCgpICsKICBsYWJzKHggPSAiUHJpbmNpcGFsIGNvbXBvbmVudCIsCiAgICAgICB5ID0gIlBlcmNlbnQgdmFyaWFuY2UgZXhwbGFpbmVkIiwKICAgICAgIHRpdGxlID0gIlNjcmVlIHBsb3Qgb2YgZG9nIHRyYWl0cyIpKQpgYGAKCiMjIyBTY29yZXMgcGxvdAoKIyMjIyBXaXRoIGBmdml6X3BjYV9pbmQoKWAKYGBge3J9CmZ2aXpfcGNhX2luZCh0cmFpdF9wY2EpCmBgYAoKIyMjIyBNYW51YWxseQpgYGB7cn0KIyBjcmVhdGUgYSBkZiBvZiB0cmFpdF9wY2EkeApzY29yZXNfcmF3IDwtIGFzLmRhdGEuZnJhbWUodHJhaXRfcGNhJHgpCgojIGJpbmQgYnJlZWQgbmFtZQpzY29yZXMgPC0gYmluZF9jb2xzKGJyZWVkX3RyYWl0c1ssMV0sICMgZmlyc3QgY29sdW1uIHdoZXJlIHdlIGhhdmUgYnJlZWQgbmFtZQogICAgICAgICAgICAgICAgICAgIHNjb3Jlc19yYXcpCgojIGNyZWF0ZSBvYmplY3RzIGluZGljYXRpbmcgcGVyY2VudCB2YXJpYW5jZSBleHBsYWluZWQgYnkgUEMxIGFuZCBQQzIKUEMxX3BlcmNlbnQgPC0gcm91bmQoKGltcG9ydGFuY2VbMiwxXSkqMTAwLCAjIGluZGV4IDJuZCByb3csIDFzdCBjb2x1bW4sIHRpbWVzIDEwMAogICAgICAgICAgICAgICAgICAgICAxKSAjIHJvdW5kIHRvIDEgZGVjaW1hbApQQzJfcGVyY2VudCA8LSByb3VuZCgoaW1wb3J0YW5jZVsyLDJdKSoxMDAsIDEpIAoKIyBwbG90CihzY29yZXNfcGxvdCA8LSBzY29yZXMgJT4lCiAgZ2dwbG90KGFlcyh4ID0gUEMxLCB5ID0gUEMyKSkgKwogIGdlb21faGxpbmUoeWludGVyY2VwdCA9IDAsIGxpbmV0eXBlID0gImRhc2hlZCIpICsKICBnZW9tX3ZsaW5lKHhpbnRlcmNlcHQgPSAwLCBsaW5ldHlwZSA9ICJkYXNoZWQiKSArCiAgZ2VvbV9wb2ludChjb2xvciA9ICJibGFjayIpICsKICB0aGVtZV9taW5pbWFsKCkgKwogIGxhYnMoeCA9IGdsdWUoIlBDMToge1BDMV9wZXJjZW50fSUiKSwgCiAgICAgICB5ID0gZ2x1ZSgiUEMyOiB7UEMyX3BlcmNlbnR9JSIpLCAKICAgICAgIHRpdGxlID0gIlBDQSBTY29yZXMgUGxvdCBvZiBBbWVyaWNhbiBLZW5uZWwgQ2x1YiBEb2cgVHJhaXQgRGF0YSIpKQpgYGAKCiMjIyBMb2FkaW5ncyBwbG90CiMjIyMgV2l0aCBgZnZpel9wY2FfdmFyKClgCmBgYHtyfQpmdml6X3BjYV92YXIodHJhaXRfcGNhKQpgYGAKCgojIyMjIE1hbnVhbGx5CmBgYHtyfQojIGdyYWIgcmF3IGxvYWRpbmdzLCB3aXRob3V0IGFueSBtZXRhZGF0YQpsb2FkaW5nc19yYXcgPC0gYXMuZGF0YS5mcmFtZSh0cmFpdF9wY2Ekcm90YXRpb24pCgojIG1vdmUgcm93bmFtZSB0byBjb2x1bW4KbG9hZGluZ3MgPC0gbG9hZGluZ3NfcmF3ICU+JQogIHJvd25hbWVzX3RvX2NvbHVtbih2YXIgPSAiVHJhaXQiKQoKKGxvYWRpbmdzX3Bsb3QgPC0gbG9hZGluZ3MgJT4lCiAgZ2dwbG90KGFlcyh4ID0gUEMxLCB5ID0gUEMyLCBsYWJlbCA9IFRyYWl0KSkgKwogIGdlb21faGxpbmUoeWludGVyY2VwdCA9IDAsIGxpbmV0eXBlID0gImRhc2hlZCIpICsKICBnZW9tX3ZsaW5lKHhpbnRlcmNlcHQgPSAwLCBsaW5ldHlwZSA9ICJkYXNoZWQiKSArICAKICBnZW9tX3BvaW50KCkgKwogIGdlb21fbGFiZWxfcmVwZWwoc2l6ZSA9IDIuNSkgKwogIHRoZW1lX21pbmltYWwoKSArCiAgbGFicyh4ID0gZ2x1ZSgiUEMxOiB7UEMxX3BlcmNlbnR9JSIpLCAKICAgICAgIHkgPSBnbHVlKCJQQzI6IHtQQzJfcGVyY2VudH0lIiksIAogICAgICAgdGl0bGUgPSAiUENBIExvYWRpbmdzIFBsb3Qgb2YgQW1lcmljYW4gS2VubmVsIENsdWIgRG9nIFRyYWl0IERhdGEiKSkKYGBgCgojIyMgU2NyZWUgYW5kIHNjb3JlcyBwbG90cwpgYGB7cn0Kc2NyZWVfcGxvdCArIHNjb3Jlc19wbG90CmBgYAoKCiMjIDIuIE1ha2UgeW91ciBQQ0EgcGxvdCBpbnRlcmFjdGl2ZSAoMiBwdHMpCgpNYWtlIHlvdXIgUENBIHNjb3JlcyBwbG90IGludGVyYWN0aXZlLCBhbmQgc28gdGhhdCB3aGVuIHlvdSBob3ZlciBlYWNoIHBvaW50LCB5b3UgY2FuIHNlZSB3aGF0IHRoZSBuYW1lIG9mIHRoYXQgZG9nIGJyZWVkIGlzIChhbmQgb25seSB0aGUgYnJlZWQgb2YgdGhhdCBkb2cpLgoKYGBge3IsIG1lc3NhZ2UgPSBGQUxTRSwgd2FybmluZyA9IEZBTFNFfQpzY29yZXNfcGxvdGx5IDwtIHNjb3JlcyAlPiUKICBnZ3Bsb3QoYWVzKHggPSBQQzEsIHkgPSBQQzIsIHRleHQgPSBCcmVlZCkpICsKICBnZW9tX2hsaW5lKHlpbnRlcmNlcHQgPSAwLCBsaW5ldHlwZSA9ICJkYXNoZWQiKSArCiAgZ2VvbV92bGluZSh4aW50ZXJjZXB0ID0gMCwgbGluZXR5cGUgPSAiZGFzaGVkIikgKwogIGdlb21fcG9pbnQoY29sb3IgPSAiYmxhY2siKSArCiAgdGhlbWVfbWluaW1hbCgpICsKICBsYWJzKHggPSBnbHVlKCJQQzE6IHtQQzFfcGVyY2VudH0lIiksIAogICAgICAgeSA9IGdsdWUoIlBDMjoge1BDMl9wZXJjZW50fSUiKSwgCiAgICAgICB0aXRsZSA9ICJQQ0EgU2NvcmVzIFBsb3Qgb2YgQW1lcmljYW4gS2VubmVsIENsdWIgRG9nIFRyYWl0IERhdGEiKQoKZ2dwbG90bHkoc2NvcmVzX3Bsb3RseSwgdG9vbHRpcCA9ICJ0ZXh0IikKYGBgCgojIyAzLiBTZWUgaG93IHlvdXIgUENBIHJlbGF0ZWQgdG8gYnJlZWQgcG9wdWxhcml0eSAoMiBwdHMpCgpVc2luZyBgYnJlZWRfdHJhaXRzYCBhbmQgYGJyZWVkX3JhbmtfYWxsYCwgbGFiZWwgdGhlIHBvaW50cyB0aGF0IHNob3cgZGF0YSBmb3IgdGhlIHRvcCAxMCBkb2cgYnJlZWRzIGluIDIwMjAgYW5kIGNvbG9yIHRoZW0gZGlmZmVyZW50IGZyb20gdGhlIHJlc3Qgb2YgdGhlIHBvaW50cy4gWW91ciBwbG90IGRvZXMgbm90IG5lZWQgdG8gYmUgaW50ZXJhY3RpdmUuCgpUcnkgam9pbmluZyB0aGUgZGZzIGJhc2VkIG9uIEJyZWVkCmBgYHtyfQojIGdyYWIganVzdCBicmVlZCBhbmQgdGhlIHJhbmsgaW4gMjAyMApicmVlZF9yYW5rX3RvX2pvaW4gPC0gYnJlZWRfcmFua19hbGwgJT4lCiAgc2VsZWN0KEJyZWVkLCBgMjAyMCBSYW5rYCkKCiMgam9pbiB3aXRoIGJyZWVkX3RyYWl0cyAgCmpvaW5lZCA8LSBsZWZ0X2pvaW4oYnJlZWRfdHJhaXRzLCBicmVlZF9yYW5rX3RvX2pvaW4sCiAgICAgICAgICAgICAgICAgICAgYnkgPSAiQnJlZWQiKQoKIyBjaGVjawprbml0cjo6a2FibGUoaGVhZChqb2luZWQpKQpgYGAKCldlIGhhdmUgYSBidW5jaCBvZiBOQXMgaW4gYDIwMjAgUmFua2AgbGV0cyBmaWd1cmUgb3V0IHdoeS4gSSBub3RpY2Ugd2UgaGF2ZSBOQXMgaW4gYWxsIHRoZSBCcmVlZCBuYW1lcyB0aGF0IGhhdmUgc3BhY2VzCmBgYHtyfQojIGNyZWF0ZSBhIHZlY3RvciBvZiBicmVlZCBmcm9tIGVhY2ggZGYKYnJlZWRfdHJhaXRzX2JyZWVkIDwtIGJyZWVkX3RyYWl0cyRCcmVlZApicmVlZF9yYW5rX2JyZWVkIDwtIGJyZWVkX3JhbmtfYWxsJEJyZWVkCgojIGFyZSB0aGV5IHRoZSBzYW1lPwphbGwuZXF1YWwoYnJlZWRfdHJhaXRzX2JyZWVkLCBicmVlZF9yYW5rX2JyZWVkKSAjIG5vLCBtYW55IHN0cmluZyBtaXNtYXRjaGVzCgojIHRlc3Rpbmcgd2l0aCBGcmVuY2ggQnVsbGRvZ3MgYmMgdGhvc2UgYXJlIG15IGZhdgp0ZXN0MSA8LSBicmVlZF90cmFpdHNfYnJlZWRbMl0KdGVzdDIgPC0gYnJlZWRfcmFua19icmVlZFsyXQoKbGlicmFyeShzdHJpbmdpKSAjIGhhcyB0aGUgZnVuY3Rpb24gc3RyaV9jb21wYXJlKCkKc3RyaV9jb21wYXJlKHRlc3QxLCB0ZXN0MikgIyAxIHN0cmluZyBkaWZmZXJlbnQsIGJ1dCBvayB3aGljaCBvbmU/CgpsaWJyYXJ5KGRldnRvb2xzKSAjIGFsbG93cyB5b3UgdG8gdXNlIGluc3RhbGxfZ2l0aHViCmluc3RhbGxfZ2l0aHViKCJyZW5vemFvL3BrZ21ha2VyIikgIyBpbnN0YWxsIHBrZ21ha2VyIGZvciBzdHJpbmcgY29tcGFyaXNvbgpsaWJyYXJ5KHBrZ21ha2VyKQoKc3RyX2RpZmYodGVzdDEsIHRlc3QyKSAjIHRoZSBwcm9ibGVtIGlzIGluIHRoZSBzcGFjZSEgQnV0IHdoYXQ/IEl0IGxvb2tzIHRoZSBzYW1lIHRvIG1lCgojIHRoaXMgc29sdXRpb24gd2FzIGZyb20gRGFuIFpoYW5nICh0aGFua3MgRGFuISkKY2hhclRvUmF3KHRlc3QxKQpjaGFyVG9SYXcodGVzdDIpCiMgdGVzdDEgaGFzIGMyYTAgZm9yIHRoZSBzcGFjZSwgYW5kIHRlc3QyIGhhcyAyMAojIGMyYTAgaXMgYSB3ZWlyZCB0eXBlIG9mIHNwYWNlLCBhbmQgMjAgaXMgdGhlIHJlZ3VsYXIgc3BhY2UKIyBpZiB5b3UgYWN0dWFsbHkgZG93bmxvYWQgYW5kIG9wZW4gdGhlIGNzdnMgaW4gYSBwcm9ncmFtIGxpa2UgZXhjZWwKIyB5b3Ugd2lsbCBzZWUgc29tZSB3ZWlyZCB1bmljb2RlIG5vbnNlbnNlIChteSBmYXVsdCkKCgpgYGAKCgpUcnlpbmcgYW5vdGhlciB3YXkgdG8gam9pbi4gU2luY2Ugd2UgY2FuIGNoZWNrIHRoYXQgdGhlIGRmcyBhcmUgb3JkZXJlZCB0aGUgc2FtZSB3YXksIHdlIGNhbiBqb2luIGJ5IHVzaW5nIGBiaW5kX2NvbHMoKWAuCmBgYHtyfQojIGNyZWF0ZSBkZiBvZiBqdXN0IDIwMjAgcmFuayB0byBhZGQgdG8gYmluZCB0byBzY29yZXMKcmFuazIwMjAgPC0gYnJlZWRfcmFua19hbGwgJT4lCiAgc2VsZWN0KGAyMDIwIFJhbmtgKQoKIyBiaW5kIHRvIHNjb3JlcwojIGpvaW5pbmcgaXMgdG91Z2ggaGVyZSBiZWNhdXNlIGl0IGRvZXNuJ3QgaGFuZGxlIHNwYWNlcyB3ZWxsCiMgaGVyZSBpIG1hZGUgc3VyZSB0aGF0IGJvdGggZGZzIHdlcmUgb3JkZXJlZCBleGFjdGx5IHRoZSBzYW1lIHdheQpzY29yZXNfcG9wdWxhcml0eSA8LSBiaW5kX2NvbHMoc2NvcmVzLCByYW5rMjAyMCkKCnNjb3Jlc19wb3B1bGFyaXR5X3RvcDEwIDwtIHNjb3Jlc19wb3B1bGFyaXR5ICU+JQogIGZpbHRlcihgMjAyMCBSYW5rYCA8PSAxMCkKYGBgCgpCeSBjcmVhdGluZyBhIG5ldyBkZiBhbmQgcGxvdHRpbmcKYGBge3J9CiMgY3JlYXRpbmcgYSBuZXcgZGYgYW5kIHBsb3R0aW5nCnNjb3Jlc19wb3B1bGFyaXR5ICU+JQogIGdncGxvdCgpICsKICBnZW9tX2hsaW5lKHlpbnRlcmNlcHQgPSAwLCBsaW5ldHlwZSA9ICJkYXNoZWQiKSArCiAgZ2VvbV92bGluZSh4aW50ZXJjZXB0ID0gMCwgbGluZXR5cGUgPSAiZGFzaGVkIikgKwogIGdlb21fcG9pbnQoYWVzKHggPSBQQzEsIHkgPSBQQzIpKSArCiAgZ2VvbV9wb2ludChkYXRhID0gc2NvcmVzX3BvcHVsYXJpdHlfdG9wMTAsCiAgICAgICAgICAgICBhZXMoeCA9IFBDMSwgeSA9IFBDMiksIGNvbG9yID0gImRhcmtjeWFuIikgKyAgCiAgZ2VvbV9sYWJlbF9yZXBlbChkYXRhID0gc2NvcmVzX3BvcHVsYXJpdHlfdG9wMTAsCiAgICAgICAgICAgICAgICAgIGFlcyh4ID0gUEMxLCB5ID0gUEMyLCBsYWJlbCA9IEJyZWVkKSwgCiAgICAgICAgICAgICAgICAgIGNvbG9yID0gImRhcmtjeWFuIiwgc2l6ZSA9IDIuNSkgKwogIHRoZW1lX21pbmltYWwoKSArCiAgdGhlbWUobGVnZW5kLnBvc2l0aW9uID0gIm5vbmUiKSArCiAgbGFicyh4ID0gZ2x1ZSgiUEMxOiB7UEMxX3BlcmNlbnR9JSIpLCAKICAgICAgIHkgPSBnbHVlKCJQQzI6IHtQQzJfcGVyY2VudH0lIiksIAogICAgICAgdGl0bGUgPSAiUENBIFNjb3JlcyBQbG90IG9mIEFtZXJpY2FuIEtlbm5lbCBDbHViIERvZyBUcmFpdCBEYXRhIiwKICAgICAgIHN1YnRpdGxlID0gIkxhYmVsbGVkIHBvaW50cyBhcmUgdGhlIHRvcCAxMCBtb3N0IHBvcHVsYXIgYnJlZWRzIGZyb20gMjAyMCIpCmBgYAoKV2l0aG91dCBjcmVhdGluZyBhIG5ldyBkZiwgYW5kIHVzaW5nIGBpZl9lbHNlKClgCmBgYHtyfQojIHdpdGhvdXQgY3JlYXRpbmcgYSBuZXcgZGYgYW5kIGlmX2Vsc2UKc2NvcmVzX3BvcHVsYXJpdHkgJT4lCiAgZ2dwbG90KGFlcyh4ID0gUEMxLCB5ID0gUEMyKSkgKwogIGdlb21faGxpbmUoeWludGVyY2VwdCA9IDAsIGxpbmV0eXBlID0gImRhc2hlZCIpICsKICBnZW9tX3ZsaW5lKHhpbnRlcmNlcHQgPSAwLCBsaW5ldHlwZSA9ICJkYXNoZWQiKSArCiAgZ2VvbV9wb2ludCgpICsKICBnZW9tX3BvaW50KGNvbG9yID0gaWZfZWxzZShzY29yZXNfcG9wdWxhcml0eSRgMjAyMCBSYW5rYCA8PSAxMCwgImRhcmtjeWFuIiwgImJsYWNrIikpICsKICBnZW9tX2xhYmVsX3JlcGVsKGFlcyhsYWJlbCA9IGlmX2Vsc2UoYDIwMjAgUmFua2AgPD0gMTAsIEJyZWVkLCBOVUxMKSksCiAgICAgICAgICAgICAgICAgICBzaXplID0gMi41LCBjb2xvciA9ICJkYXJrY3lhbiIpICsKICB0aGVtZV9taW5pbWFsKCkgKwogIHRoZW1lKGxlZ2VuZC5wb3NpdGlvbiA9ICJub25lIikgKwogIGxhYnMoeCA9IGdsdWUoIlBDMToge1BDMV9wZXJjZW50fSUiKSwgCiAgICAgICB5ID0gZ2x1ZSgiUEMyOiB7UEMyX3BlcmNlbnR9JSIpLCAKICAgICAgIHRpdGxlID0gIlBDQSBTY29yZXMgUGxvdCBvZiBBbWVyaWNhbiBLZW5uZWwgQ2x1YiBEb2cgVHJhaXQgRGF0YSIsCiAgICAgICBzdWJ0aXRsZSA9ICJMYWJlbGxlZCBwb2ludHMgYXJlIHRoZSB0b3AgMTAgbW9zdCBwb3B1bGFyIGJyZWVkcyBmcm9tIDIwMjAiKQpgYGAKClVzaW5nIGBnZ2hpZ2hsaWdodCgpYApgYGB7cn0KIyB1c2luZyBnZ2hpZ2hsaWdodApzY29yZXNfcG9wdWxhcml0eSAlPiUKICBnZ3Bsb3QoKSArCiAgZ2VvbV9obGluZSh5aW50ZXJjZXB0ID0gMCwgbGluZXR5cGUgPSAiZGFzaGVkIikgKwogIGdlb21fdmxpbmUoeGludGVyY2VwdCA9IDAsIGxpbmV0eXBlID0gImRhc2hlZCIpICsKICBnZW9tX3BvaW50KGFlcyh4ID0gUEMxLCB5ID0gUEMyKSkgKwogIGdnaGlnaGxpZ2h0KGAyMDIwIFJhbmtgIDw9IDEwLCB1c2VfZGlyZWN0X2xhYmVsID0gVFJVRSwgbGFiZWxfa2V5ID0gQnJlZWQpICsKICB0aGVtZV9taW5pbWFsKCkgKwogIGxhYnMoeCA9IGdsdWUoIlBDMToge1BDMV9wZXJjZW50fSUiKSwgCiAgICAgICB5ID0gZ2x1ZSgiUEMyOiB7UEMyX3BlcmNlbnR9JSIpLCAKICAgICAgIHRpdGxlID0gIlBDQSBTY29yZXMgUGxvdCBvZiBBbWVyaWNhbiBLZW5uZWwgQ2x1YiBEb2cgVHJhaXQgRGF0YSIsCiAgICAgICBzdWJ0aXRsZSA9ICJMYWJlbGxlZCBwb2ludHMgYXJlIHRoZSB0b3AgMTAgbW9zdCBwb3B1bGFyIGJyZWVkcyBmcm9tIDIwMjAiKQpgYGAKCgo=